perm filename 3RAW9.SAI[BIG,HPM]1 blob
sn#143685 filedate 1975-02-04 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00003 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 BEGIN "NTONIC"
C00005 00003
C00010 ENDMK
C⊗;
BEGIN "NTONIC"
REQUIRE "DDSUB.SAI[GRA,HPM]" SOURCE_FILE;
REQUIRE "PRANDR.SAI[BIG,HPM]" SOURCE_FILE;
DEFINE NEL=3, N=3, NOPEN=3;
INTEGER DONE,FOO,I,J,K,L;
STRING S; BOOLEAN MERGE,PASS;
INTEGER ARRAY WIRE[0:N-1,0:NEL-1],STATE[0:N-1,0:NEL-1],NSET[0:NEL-1];
INTEGER ARRAY NEXT,PERM,OUTPUT,INPUTMAP[0:N*NOPEN-1];
PROCEDURE FOLLOW;
BEGIN
INTEGER I,J,K,L;
DONE←0;
WHILE DONE<NEL DO FOR I←0 STEP 1 UNTIL NEL-1 DO IF NSET[I]=N THEN
BEGIN
FOR J←1 STEP 1 UNTIL N-1 DO FOR K←0 STEP 1 UNTIL J-1 DO
IF STATE[J,I]<STATE[K,I] THEN STATE[J,I]↔STATE[K,I];
FOR J←0 STEP 1 UNTIL N-1 DO
BEGIN
K←WIRE[J,I];
IF K≥0 THEN
BEGIN
L←NSET[K];
NSET[K]←L+1;
STATE[L,K]←STATE[J,I];
END
ELSE
OUTPUT[-1-K]←STATE[J,I];
END;
NSET[I]←-N;
DONE←DONE+1;
END;
END;
PROCEDURE DRAW;
BEGIN
REAL ARRAY X,Y[0:NEL-1];
INTEGER I,J,K;
X[0]←1; Y[0]←1;
X[1]←1; Y[1]←2;
X[2]←1; Y[2]←3;
DDINIT;
SCREEN(-1,-.1,5,5);
DRKEN; RECTAN(-100,-100,100,100); LITEN;
FOR I←0 STEP 1 UNTIL NEL-1 DO RECTAN(X[I]-.1,Y[I]-.2,X[I]+.2,Y[I]+.2);
FOR I←0 STEP 1 UNTIL N*NOPEN-1 DO
LINE(0,I*4/8,X[INPUTMAP[I]],Y[INPUTMAP[I]]);
FOR I←0 STEP 1 UNTIL NEL-1 DO
FOR J←0 STEP 1 UNTIL N-1 DO
BEGIN REAL FX,FY;
FX←X[I]+.2; FY←Y[I]-.2+J*.2;
IF WIRE[J,I]<0 THEN LINE(FX,FY,4,(-1-WIRE[J,I])*4/8)
ELSE LINE(FX,FY,X[WIRE[J,I]],Y[WIRE[J,I]]);
END;
FOR I←1,2,3 DO DPYUP('36);
SHOW('36);
END;
PROCEDURE M3WAY(INTEGER FIRST; INTEGER ARRAY NEXT);
BEGIN
WIRE[0,0+FIRST]←NEXT[0];
WIRE [1,0+FIRST]←NEXT[1];
WIRE[2,0+FIRST]←NEXT[2];
WIRE[0,1+FIRST]←NEXT[3];
WIRE[1,1+FIRST]←NEXT[4];
WIRE[2,1+FIRST]←NEXT[5];
WIRE[0,2+FIRST]←NEXT[6];
WIRE[1,2+FIRST]←NEXT[7];
WIRE[2,2+FIRST]←NEXT[8];
END;
FOR J←0 STEP 1 UNTIL 8 DO
INPUTMAP[J]←J MOD 3;
OUTSTR("INPUTMAP ");
FOR I←0 STEP 1 UNTIL N*NOPEN-1 DO OUTSTR(CVS(INPUTMAP[I])&" "); OUTSTR('15&'12);
FOR I←0 STEP 1 UNTIL N*NOPEN-1 DO NEXT[I]←-1-I;
M3WAY(0,NEXT);
DRAW;
OUTSTR('12&"WIRES "&'15&'12);
FOR J←0 STEP 1 UNTIL 2 DO
BEGIN
FOR I←0 STEP 1 UNTIL NEL-1 DO OUTSTR(CVS(WIRE[J,I])&" ");
OUTSTR('15&'12);
END;
OUTSTR('15&'12&'12);
BEGIN
INTEGER ARRAY CNTR[1:N*NOPEN];
INTEGER ARRAY CHECK[0:N*NOPEN,0:N*NOPEN];
FOR I←1 STEP 1 UNTIL N*NOPEN DO CNTR[I]←(N*NOPEN-I)%NOPEN;
MERGE←TRUE;
DO
BEGIN
K←-1;
FOR I←N-1 STEP -1 UNTIL 0 DO FOR J←1 STEP 1 UNTIL N*NOPEN DO
IF CNTR[J]=I THEN PERM[K←K+1]←J;
FOR I←0 STEP 1 UNTIL NEL-1 DO NSET[I]←0;
FOR I←0 STEP 1 UNTIL N*NOPEN-1 DO
BEGIN
K←INPUTMAP[I];
L←NSET[K];
NSET[K]←L+1;
STATE[L,K]←PERM[I];
END;
FOLLOW;
PASS←FALSE;
FOR K←0 STEP 1 UNTIL N*NOPEN-1 DO
BEGIN
L←0; WHILE CHECK[K,L]≠0∧CHECK[K,L]<OUTPUT[K] DO L←L+1;
IF CHECK[K,L]≠OUTPUT[K] THEN
BEGIN
WHILE OUTPUT[K]≠0 DO
BEGIN
CHECK[K,L]↔OUTPUT[K];
L←L+1;
END;
PASS←TRUE;
END;
END;
IF PASS THEN
BEGIN
DRKEN; RECTAN(4.01,-100,100,100); LITEN;
FOR K←0 STEP 1 UNTIL N*NOPEN-1 DO
BEGIN
TXTPOS(4.01,(N*NOPEN-1-K-.5)*4/8,.1,.2);
L←0; WHILE CHECK[K,L]≠0 DO TEXT('77+CHECK[K,(L←L+1)-1]);
END;
DPYUP('36);
END;
PWITHR(CNTR,N*NOPEN,MERGE);
END UNTIL MERGE;
END;
END;